home *** CD-ROM | disk | FTP | other *** search
/ Programming Languages Suite / ProgramD2.iso / Borland / Borland Pascal with Objects 7.0 / TVDEMO.ZIP / GADGETS.PAS < prev    next >
Pascal/Delphi Source File  |  1992-10-27  |  2KB  |  126 lines
  1. {************************************************}
  2. {                                                }
  3. {   Turbo Vision Demo                            }
  4. {   Copyright (c) 1992 by Borland International  }
  5. {                                                }
  6. {************************************************}
  7.  
  8. unit Gadgets;
  9.  
  10. {$F+,O+,S-,D-,Q-}
  11.  
  12. { Useful gadgets: clock and heap available viewer }
  13.  
  14. interface
  15.  
  16. uses Dos, Objects, Views, App;
  17.  
  18. type
  19.   PHeapView = ^THeapView;
  20.   THeapView = object(TView)
  21.     OldMem : LongInt;
  22.     constructor Init(var Bounds: TRect);
  23.     procedure Draw; virtual;
  24.     procedure Update;
  25.   end;
  26.  
  27.   PClockView = ^TClockView;
  28.   TClockView = object(TView)
  29.     Refresh: Byte;
  30.     LastTime: DateTime;
  31.     TimeStr: string[10];
  32.     constructor Init(var Bounds: TRect);
  33.     procedure Draw; virtual;
  34.     function FormatTimeStr(H, M, S: Word): String; virtual;
  35.     procedure Update; virtual;
  36.   end;
  37.  
  38.  
  39. implementation
  40.  
  41. uses Drivers;
  42.  
  43. {------ Heap Window object ----------}
  44.  
  45. constructor THeapView.Init(var Bounds: TRect);
  46. begin
  47.   inherited Init(Bounds);
  48.   OldMem := 0;
  49. end;
  50.  
  51. procedure THeapView.Draw;
  52. var
  53.   S: String;
  54.   B: TDrawBuffer;
  55.   C: Byte;
  56. begin
  57.   OldMem := MemAvail;
  58.   Str(OldMem:Size.X, S);
  59.   C := GetColor(2);
  60.   MoveChar(B, ' ', C, Size.X);
  61.   MoveStr(B, S, C);
  62.   WriteLine(0, 0, Size.X, 1, B);
  63. end;
  64.  
  65.  
  66. procedure THeapView.Update;
  67. begin
  68.   if (OldMem <> MemAvail) then DrawView;
  69. end;
  70.  
  71. {-------- ClockView Object --------}
  72.  
  73. function LeadingZero(w: Word): String;
  74. var s: String;
  75. begin
  76.   Str(w:0, s);
  77.   LeadingZero := Copy('00', 1, 2 - Length(s)) + s;
  78. end;
  79.  
  80. constructor TClockView.Init(var Bounds: TRect);
  81. begin
  82.   inherited Init(Bounds);
  83.   FillChar(LastTime, SizeOf(LastTime), #$FF);
  84.   TimeStr := '';
  85.   Refresh := 1;
  86. end;
  87.  
  88.  
  89. procedure TClockView.Draw;
  90. var
  91.   B: TDrawBuffer;
  92.   C: Byte;
  93. begin
  94.   C := GetColor(2);
  95.   MoveChar(B, ' ', C, Size.X);
  96.   MoveStr(B, TimeStr, C);
  97.   WriteLine(0, 0, Size.X, 1, B);
  98. end;
  99.  
  100.  
  101. procedure TClockView.Update;
  102. var
  103.   h,m,s,hund: word;
  104. begin
  105.   GetTime(h,m,s,hund);
  106.   if Abs(s - LastTime.sec) >= Refresh then
  107.   begin
  108.     with LastTime do
  109.     begin
  110.       Hour := h;
  111.       Min := m;
  112.       Sec := s;
  113.     end;
  114.     TimeStr := FormatTimeStr(h, m, s);
  115.     DrawView;
  116.   end;
  117. end;
  118.  
  119. function TClockView.FormatTimeStr(H, M, S: Word): String;
  120. begin
  121.   FormatTimeStr := LeadingZero(h)+ ':'+ LeadingZero(m) +
  122.     ':' + LeadingZero(s);
  123. end;
  124.  
  125. end.
  126.